Usenet 1993 July

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume10 / logo / part01 next >

Wrap

Internet Message Format | 1987-06-23 | 59.6 KB

Path: uunet!rs From: rs@uunet.UU.NET (Rich Salz) Newsgroups: comp.sources.unix Subject: v10i021: Logo interpreter for Unix, Part01/06 Message-ID: <447@uunet.UU.NET> Date: 24 Jun 87 20:21:29 GMT Organization: UUNET Communications Services, Arlington, VA Lines: 2243 Approved: rs@uunet.uu.net Submitted by: Brian Harvey <bh@mit-amt> Mod.Sources: Volume 10, Number 21 Archive-Name: logo/Part01 [ Logo is a a way of life, not just a programming language. Here's the definitive Unix release from one of the primary prophets. --r$ ] #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 1 (of 6)." # Contents: MANIFEST README adm.i admtek.i atari.i dr11k.c gigi.i # helpfile library library/beep.lg library/f.lg library/g.lg # library/gigimove.lg library/hanoi.lg library/home.lg # library/howis.lg library/l.lg library/laugh.lg library/listp.lg # library/pick.lg library/poly.lg library/pos.lg library/quest.lg # library/quiz1.lg library/setcursor.lg library/setheight.lg # library/setitalic.lg library/setpos.lg library/setsize.lg # library/setslant.lg library/setslope.lg library/setx.lg # library/sety.lg library/textprint.lg library/top.lg # library/towards.lg logohead.c main.c makefile makehelp proplist.c # splithelp.c sun.i tek.i unix.c zerr.c # Wrapped by rsalz@pineapple.bbn.com on Wed Jun 24 14:26:50 1987 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f MANIFEST -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"MANIFEST\" else echo shar: Extracting \"MANIFEST\" $1926 characters$ sed "s/^X//" >MANIFEST <<'END_OF_MANIFEST' X File Name Archive # Description X----------------------------------------------------------- X MANIFEST 1 X README 1 X adm.i 1 X admtek.i 1 X applediff 2 X atari.i 1 X dr11k.c 1 X gigi.i 1 X helpfile 1 X library 1 X library/beep.lg 1 X library/f.lg 1 X library/g.lg 1 X library/gigimove.lg 1 X library/hanoi.lg 1 X library/home.lg 1 X library/howis.lg 1 X library/l.lg 1 X library/laugh.lg 1 X library/listp.lg 1 X library/pick.lg 1 X library/poly.lg 1 X library/pos.lg 1 X library/quest.lg 1 X library/quiz1.lg 1 X library/setcursor.lg 1 X library/setheight.lg 1 X library/setitalic.lg 1 X library/setpos.lg 1 X library/setsize.lg 1 X library/setslant.lg 1 X library/setslope.lg 1 X library/setx.lg 1 X library/sety.lg 1 X library/textprint.lg 1 X library/top.lg 1 X library/towards.lg 1 X logo.h 2 X logo.y 4 X logoaux.c 3 X logohead.c 1 X logoman.1 5 X logoman.2 6 X logonum.c 2 X logoop.c 3 X logoparse.c 2 X logoproc.c 3 X main.c 1 X makefile 1 X makehelp 1 X olddiff 2 X procedit.c 2 X procvars.c 2 X proplist.c 1 X splithelp.c 1 X storage.c 2 X sun.i 1 X tek.i 1 X turtle.c 3 X unix.c 1 X zerr.c 1 END_OF_MANIFEST if test 1926 -ne `wc -c <MANIFEST`; then echo shar: \"MANIFEST\" unpacked with wrong size! fi # end of overwriting check fi if test -f README -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"README\" else echo shar: Extracting \"README\" $10027 characters$ sed "s/^X//" >README <<'END_OF_README' XUnix Logo Interpreter X Brian Harvey X Lincoln-Sudbury Regional High School X XThis is release 4 of Unix Logo. It differs from release 3 in that it Xmore closely follows the syntax of LCSI versions of Logo (Apple Logo, XIBM Logo, etc.) In particular, multiple commands on a line are allowed Xwithout semicolons required between them. The prompt character is '?' Xinstead of '*' as before. The abbreviations 'f', 'l', and 'top' have Xbeen eliminated. Positioned text (cleartext and setcursor) are supported Xusing termlib. The 'random' primitive now takes an input, like 'rnd', Xinstead of being equivalent to 'rnd 10' as before. Error messages are Xcloser to those in other versions of Logo. Procedure names can be longer Xthan 11 characters if your version of Unix has long file names. X XThe following obsolete paragraph is included to help users of previous Xversions understand the version history. X X----- XThis is release 3.2 of Unix Logo. Release 1 was the one on the first 1982 XUsenix tape. Release 2 was sent by me (BH) directly to only a few sites. XThis release is much like release 2 in capabilities and syntax, but has Xbeen rearranged internally somewhat to make the process of installation Xon a new system a bit easier. One major new feature in release 3 is the Xpause facility, which allows interactive debugging in the local context Xof an error. More on this below. Release 3.1 differs from 3 only in a Xfew bug fixes and in what is left out under the SMALL option. Release 3.2 Xdiffers from release 3.1 in bug fixes, better error messages, and one Xincompatible change: the quotient of two integers can be a non-integer. X----- X XI would like to thank Don Martin and his students at the College of Marin, Xwho have found huge numbers of obscure bugs in Logo and therefore helped Xmake this release much more reliable than it would otherwise have been. X XLogo is a programming language for education. It is, I think, unquestionably Xthe best introductory learning language now available, because it combines Xthe ease of an interactive language (like BASIC, otherwise terrible) with Xthe power and structure of a procedural language (like Pascal, not bad once Xyou get past the details of editing and compiling and loading and semicolons Xand does var go before or after const). If you aren't convinced, read the Xbook "Mindstorms" by Seymour Papert. It doesn't matter how old your Xstudents are. X XThis directory contains an interpreter for the Logo programming language. XThe interpreter is written in C and YACC, and runs under Unix(TM) version 7. XIt has been exported also to Vax 4BSD and to Idris on a PDP-11. This program Xis based on a Logo interpreter originally written at the Boston Children's XMuseum; the present version is very much improved in its capabilities. On Xthe other hand, the original version ran in a 64Kb address space; this version Xrequires split I/D on the PDP-11. (It can be run on a smaller 11 by turning Xon the definition of SMALL in logo.h, but with hardly any recursion allowed. XThis configuration just barely works and is not recommended. If someone with Xsuch a system wants to tune it up and send me the results, please do. SMALL Xeliminates the pause feature (pause, continue, errpause, etc.) and the Xproperty list feature (pprop, gprop, etc.) as well as using short ints and Xfloats instead of long ints and doubles.) X XThe file "logoman" in this directory is an nroff-format reference manual. It's Xvery terse; you should really learn Logo from some other manual and use this Xone just to learn about idiosyncracies. There are also two smaller Xdocumentation files, "applediff" for people accustomed to Apple XLogo, and "olddiff" for people accustomed to the first LSRHS release. XIf you are getting this file via Usenet comp.sources.unix, you will Xhave to do "cat logoman.[12] >logoman" first. X XUsers of the first release of LSRHS Logo (the one on the Usenix 82.1 tape) Xwill find the present version more robust and also more featureful. Its Xsyntax is much like that of Apple Logo, which should be helpful to people Xwith Apples as well as real computers. Line numbers have been flushed, Xexcept for use with the go command. The kludgy re-entrant use of the YACC Xparser has been eliminated. X XThe enclosed makefile should manage to compile this Logo with no errors. XYou will have to make some modifications for local conditions, most notably Xin the area of turtle graphics. Most installation dependencies have been Xcollected at the beginning of the file logo.h which is included in all Xcompilations. X XTURTLE GRAPHICS. You must #define symbols in logo.h for the kind(s) of Xdisplay hardware you support. Also, if you have a graphics terminal which Xis not one of the ones already supported in this release, you'll have to Xadd some code to turtle.c to support it. The enclosed turtle.c Xknows about six kinds of graphics hardware: X 1) Terrapin floor turtles, connected via DR11-K interfaces. X 2) Atari 800 personal computers, running a special terminal program. X 3) DEC GIGI graphics terminals. X 4) Retrographics boards (known to work with ADM-5 terminals, X maybe also for other Retrographics products). X 5) Tektronix 4014 storage tube displays (with severe restrictions X because of their inability to erase selectively). X 6) Sun Microsystems workstations. XThe files ./*.i contain terminal-specific code which is #included in the Xcompilation of turtle.c if the corresponding terminal is #defined in logo.h. XThe code for floor turtles is done very differently and is not separated into Xa .i file because, alas, it's not so modular. If you have neither graphics Xterminals nor floor turtles, you should turn on the NOTURTLE definition in Xlogo.h to eliminate the turtle primitives. X XDEFAULT EDITOR. The "edit" command in Logo does not use an editor built Xinto Logo itself. Instead, it forks and runs your favorite editor in a Xnew process. If you have an EDITOR variable in your environment, it uses Xthat editor (it tries with /bin, /usr/bin, and nothing prepended). If not, Xit uses the editor specified in the EDT definition in logo.h. This is X"jove" in the version as distributed. X XINPUT WAITING TEST. The "keyp" operation depends on a system call to Xcheck for characters waiting to be read from the keyboard. If you are Xrunning a Berkeley-derived Unix, this will work correctly. If not, but Xyou have your own such system call, edit procedure keyp() in logoaux.c Xto use your own version. X XFILENAME FORMAT. Each Logo procedure is stored in a file called <name>.lg Xin the current working directory. Under version 7 Unix, this allows names Xof procedures to be up to eleven letters long. VMS filenames can only be Xnine letters. The parameter NAMELEN in logo.h should be adjusted. (Note: Xdepending on when you got your version of Eunice, it may allow real Unix Xfilenames, in which case you needn't worry about this.) X XTHE PAUSE FEATURE. You can pause on an error Xinside a procedure, so you can examine the context interactively. The Xpause feature distinguishes SIGINT and SIGQUIT, which were treated identically Xin earlier releases. In the normal distribution, SIGQUIT returns to toplevel, Xwhereas SIGINT causes a pause. The problem is with Eunice, which doesn't Xprovide SIGQUIT because VMS doesn't have enough interrupt characters. XTherefore, the standard distribution allows pausing but not quitting to Xtoplevel, although you can say "toplevel" while paused. If you'd rather Xhave quitting be the default, as in previous releases, interchange the Xdefinitions of PAUSESIG and OTHERSIG in logo.h; there are also commands Xto allow the user to make this switch dynamically. X X(Eunice users: Until just recently, an obscure bug in Eunice had the effect Xthat when you type ^C you don't see a prompt until you hit return. The switch Xcalled EUNICE in logo.h enables a workaround for this bug. Dave Kashtan has Xnow fixed the underlying problem, but not necessarily in the version you have. XIf you get too few prompts, turn on the #define EUNICE; if too many prompts, Xturn it off.) X X----- XINSTALLATION etc. X XSaying "make install" after you compile your Logo will install Logo in X/bin/logo and will also set up two directories: X /usr/lib/logo Library routines written in Logo for general use X Also stuff for edit and pots commands. X /usr/doc/logo Excerpts from the manual for the "describe" command XThe files in these directories are copied, not moved; you can delete the Xoriginals if you prefer. See the makefile. These directories must have Xthe names shown here, although you can put logo itself somewhere other than X/bin if you prefer. X XThere are three C source files included here which are not part of the Logo Xinterpreter itself. One, logohead.c, is used to compile the program X/usr/lib/logo/logohead which is used for the pots command. Another, Xsplithelp.c, is part of the makehelp shell script which is used to generate Xthe online help messages from the manual. The third C file, Xdr11k.c, is a device driver for version 7 for a DEC DR11-K used to interface XTerrapin floor turtles (you get two per DR11-K) to the PDP-11. The interface Xcosts much more than the turtles! X XINCOMPATIBILITY WITH RELEASE 2. (This release is VERY incompatible with Xrelease 1; see the file olddiff for details.) To be compatible Xwith VMS restricted filenames, to run under Eunice, the names of files used Xto store Logo procedure definitions have been changed from foo.logo to Xfoo.lg (some installations have a version of release 2 in which the name Xfoo.log is used, but that looks too much like a log file from a batch job; Xthe new version seems more Unixy anyway). If you prefer to keep the old Xconvention of .logo names, turn on the definition of EXTLOGO in logo.h. X XCheck your makefile to be sure it refers to "y.tab.c" and "y.tab.o" on XUnix, "ytab.c" and "ytab.o" on Eunice. (Again, some versions of Eunice Xuse the real Unix filenames.) X XIf you have questions about this Logo, try X Computer Department X Lincoln-Sudbury Regional High School X 390 Lincoln Road X Sudbury, MA 01776 X 617 443-9961 X END_OF_README if test 10027 -ne `wc -c <README`; then echo shar: \"README\" unpacked with wrong size! fi # end of overwriting check fi if test -f adm.i -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"adm.i\" else echo shar: Extracting \"adm.i\" $1444 characters$ sed "s/^X//" >adm.i <<'END_OF_adm.i' X/* Include file for turtle.c for ADM with Retrographics board */ X Xint admturt(),admfrom(),admto(),admstate(); Xstruct display adm ={0.0,0.0,0.0,-512.0,511.0,-390.0,389.0,1.0,0, X "","\032\035\033\014\030","","\032\035\033\014\030", X admturt,admfrom,admto,nullfn,nullfn,nullfn, X nullfn,nullfn,nullfn,admstate}; X Xadmturt(hide) Xint hide; /* nonzero to erase turtle */ X{ X double newx,newy,angle; X X printf("\035"); X angle = (mydpy->turth-90.0)*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X printf(hide ? "\033\177" : "\033a"); X plotpos((int)newx,(int)(yscrunch*newy)); X angle = mydpy->turth*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X plotpos((int)newx,(int)(yscrunch*newy)); X angle = (mydpy->turth+90.0)*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X plotpos((int)newx,(int)(yscrunch*newy)); X angle = (mydpy->turth-90.0)*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X plotpos((int)newx,(int)(yscrunch*newy)); X printf("\037\030"); X} X Xadmfrom(x,y) Xdouble x,y; X{ X printf("\035"); X printf(penerase ? "\033\177" : "\033a"); X plotpos((int)x,(int)y); X} X Xadmto(x,y) Xdouble x,y; X{ X plotpos((int)x,(int)y); X printf("\037\030"); X} X Xadmstate(which) { X if (which=='R') { X printf("ADM can't penreverse, setting pendown.\n"); X penerase = 0; X } X} X END_OF_adm.i if test 1444 -ne `wc -c <adm.i`; then echo shar: \"adm.i\" unpacked with wrong size! fi # end of overwriting check fi if test -f admtek.i -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"admtek.i\" else echo shar: Extracting \"admtek.i\" $249 characters$ sed "s/^X//" >admtek.i <<'END_OF_admtek.i' X X/* Include file for turtle.c for both ADM and TEK */ X Xplotpos(x,y) Xint x,y; X{ X char s[5]; X X x += 512; X y += 390; X s[0] = 040 + ((y>>5)&037); X s[1] = 0140 + (y&037); X s[2] = 040 + ((x>>5)&037); X s[3] = 0100 + (x&037); X s[4] = 0; X printf("%s",s); X} X END_OF_admtek.i if test 249 -ne `wc -c <admtek.i`; then echo shar: \"admtek.i\" unpacked with wrong size! fi # end of overwriting check fi if test -f atari.i -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"atari.i\" else echo shar: Extracting \"atari.i\" $2230 characters$ sed "s/^X//" >atari.i <<'END_OF_atari.i' X X/* Include file for turtle.c for Atari 800 as graphics terminal */ X Xint ataturn(),apenc(),asetc(),astate(); XNUMBER ncheck(); X Xstruct display bwatari ={0.0,0.0,0.0,-160.0,160.0,-96.0,96.0,0.875,0, X "\033#G","\033c","\033.t","\033.c", X nullfn,nullfn,nullfn,nullfn,nullfn,nullfn,ataturn, X apenc,asetc,astate}; Xstruct display colatari ={0.0,0.0,0.0,-80.0,80.0,-48.0,48.0,0.875,0, X "\033#G","\033c","\033.t","\033.c", X nullfn,nullfn,nullfn,nullfn,nullfn,nullfn,ataturn, X apenc,asetc,astate}; X Xataturn() { X printf("\033.%dh",(int)((mydpy->turth+11.0)/22.5)); X} X Xapenc(ipen) Xregister int ipen; X{ X if ((ipen<0) || (ipen>6)) { X puts("Bad pen color, must be 0 to 6."); X errhand(); X } X mydpy = (ipen ? &colatari : &bwatari); X printf("\033.%dP",ipen); X if (!(mydpy->cleared)) { X printf("\033.c"); /* clear screen */ X mydpy->cleared++; X } X X /* this is to fix bug in Atari program */ X printf("\033.%dh",(int)((mydpy->turth+11.0)/22.5)); X} X Xasetc(ipen,colorlist) Xregister int ipen; Xstruct object *colorlist; X{ X register struct object *next; X register int icolor,intens; X static int normint[] = {1,5,5,1}; X NUMBER number; X X if ((ipen<0) || (ipen>3)) { X puts("Pen number must be 0 to 3."); X errhand(); X } X X if (listp(colorlist)) { X number = ncheck(localize(colorlist->obcar)); X icolor = number; X next = colorlist->obcdr; X number = ncheck(localize(next->obcar)); X intens = number; X mfree(colorlist); X } else { X number = ncheck(colorlist); X icolor = number; X intens = normint[ipen]; X } X if ((icolor<0) || (icolor>15) || (intens<0) || (intens>7)) { X puts("Invalid color numbers."); X errhand(); X } X printf("\033.%d;%dC",ipen,(icolor*16)+(intens*2)); X} X Xastate(which) { X switch(which) { X case 'c': X fflush(stdout); X sleep(1); X case '*': X return; X case 'w': X fflush(stdout); X sleep(1); X ataturn(); X printf("\033.U\033.%d;%dG", X (int)(yscrunch*mydpy->turty),(int)(mydpy->turtx)); X if (pendown) X printf("\033.%c","DER"[penerase]); X return; X case 'G': X printf("\033.%d;%dG", X (int)(yscrunch*mydpy->turty),(int)(mydpy->turtx)); X return; X case 'R': X printf("Atari can't penreverse; setting pendown.\n"); X penerase = 0; X which = 'D'; X /* falls into */ X default: X printf("\033.%c",which); X } X} X END_OF_atari.i if test 2230 -ne `wc -c <atari.i`; then echo shar: \"atari.i\" unpacked with wrong size! fi # end of overwriting check fi if test -f dr11k.c -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"dr11k.c\" else echo shar: Extracting \"dr11k.c\" $2022 characters$ sed "s/^X//" >dr11k.c <<'END_OF_dr11k.c' X X/* X * Driver for Terrapin turtles interfaced via DR11-K. X * Based on DR-11C driver Copyright (c) 1978, the Children's Museum. X * This version by Brian Harvey, Lincoln-Sudbury Regional High School. X */ X X#include "../h/param.h" X#include "../h/dir.h" X#include "../h/user.h" X X/* The hardware registers */ Xstruct dr { X int drcsr; X char dribuf[2]; X char drobuf[2]; X}; X X#define NTURTDR 1 /* Number of DR11Ks for turtles (2 turtles per DR) */ X Xstruct dr *dr_addr[2] = { (struct dr *)0167770, (struct dr *)0167760}; X Xstruct turt { X struct proc *procp; X int time; X char turnoff; X} turtle[2*NTURTDR]; X Xstruct turtcmd { X char cmd,bits; X} trans[] ={ X 'f', 05, /* forward */ X 'b',012, /* back */ X 'l',011, /* left */ X 'r', 06, /* right */ X 'P', 0200, /* pen down */ X 'H', 060, /* high horn */ X 'L', 040, /* low horn */ X 'B', 0100, /* headlights (bright) */ X}; X X#define NCMDS (sizeof(trans) / sizeof(struct turtcmd)) X Xturtopen(dev,flag) { X dev = minor(dev); X if (dev >= 2*NTURTDR) { X u.u_error = ENXIO; X return; X } X if (turtle[dev].procp) { X u.u_error = EBUSY; X return; X } X turtle[dev].procp = u.u_procp; X} X Xturtclose(dev) { X dev = minor(dev); X turtle[dev].procp = 0; X turtle[dev].time = 0; X dr_addr[dev>>1]->drobuf[dev&01] = -1; X} X Xturttimo(dev) { X spl5(); X dr_addr[dev>>1]->drobuf[dev&01] |= turtle[dev].turnoff; X turtle[dev].time = 0; X wakeup(&turtle[dev]); X spl0(); X} X Xturtwrite(dev) { X register c,i; X X dev = minor(dev); X c = cpass(); X if (c < 0) return; X for (i=0; i<NCMDS; i++) { X if (c == trans[i].cmd) goto good; X } X cpass(); X u.u_error = EIO; X return; Xgood: X spl5(); X if((turtle[dev].time = 2*cpass()) < 0) { /* BH 8/25/80 2* */ X turtle[dev].time = 0; X spl0(); X u.u_error = EIO; X return; X } X dr_addr[dev>>1]->drobuf[dev&01] &= ~trans[i].bits; X if (turtle[dev].time) { X turtle[dev].turnoff = trans[i].bits; X timeout(turttimo,dev,turtle[dev].time); X while(turtle[dev].time) X sleep(&turtle[dev],9); X } X spl0(); X} X Xturtread(dev) { X register c; X X dev = minor(dev); X c = dr_addr[dev>>1]->dribuf[dev&01]; X passc(c); X} X END_OF_dr11k.c if test 2022 -ne `wc -c <dr11k.c`; then echo shar: \"dr11k.c\" unpacked with wrong size! fi # end of overwriting check fi if test -f gigi.i -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"gigi.i\" else echo shar: Extracting \"gigi.i\" $2132 characters$ sed "s/^X//" >gigi.i <<'END_OF_gigi.i' X X/* Include file for turtle.c for GIGI */ X Xint gigiturt(),gigifrom(),gigito(),gtcheck(),gpenc(),gstate(); Xstruct display gigi ={0.0,0.0,0.0,-384.0,383.0,-240.0,239.0,0.8,0, X "\033PpS(E)P[384,240]\033\\\033PrSM0\033\\\033[20;1H", X "\033PrSM2\033\\\033PpS(E)\033\\", X "\033PrSM2\033\\\033PpS(E)\033\\", X "\033PpS(E)\033\\", X gigiturt,gigifrom,gigito,gtcheck,nullfn,nullfn,nullfn, X gpenc,nullfn,gstate}; X Xchar *gigipens[] = {"W(R)","W(E)","W(C)"}; X Xgtcheck() { X if (textmode) { X printf("Not in text mode!\n"); X errhand(); X } X} X Xgmovepos(x,y) Xint x,y; X{ X char s[5]; X X x += 384; X y = 240 - y; X printf("P[%d,%d]",x,y); X} X Xgplotpos(x,y) Xint x,y; X{ X char s[5]; X X x += 384; X y = 240 - y; X printf("V[%d,%d]",x,y); X} X Xgigifrom(oldx,oldy) Xdouble oldx,oldy; X{ X printf("\033Pp"); X gmovepos((int)oldx,(int)oldy); X} X Xgigito(newx,newy) Xdouble newx,newy; X{ X printf(gigipens[penerase]); X gplotpos((int)newx,(int)newy); X printf("\033\\"); X} X Xgigiturt() X{ X double newx,newy,angle; X X printf("\033PpW(C)"); X angle = (mydpy->turth-90.0)*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X gmovepos((int)newx,(int)(yscrunch*newy)); X angle = mydpy->turth*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X gplotpos((int)newx,(int)(yscrunch*newy)); X angle = (mydpy->turth+90.0)*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X gplotpos((int)newx,(int)(yscrunch*newy)); X angle = (mydpy->turth-90.0)*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X gplotpos((int)newx,(int)(yscrunch*newy)); X printf(gigipens[penerase]); X printf("\033\\"); X} X Xgpenc(ipen) Xregister int ipen; X{ X if ((ipen<0) || (ipen>7)) { X puts("Bad pen color, must be 0 to 7."); X errhand(); X } X printf("\033PpW(I%d)\033\\",ipen); X} X Xgstate(which) { X switch (which) { X case 't': X printf("\033PrSM2\033\\\033PpS(E)\033\\"); X break; X case 's': X case 'f': X printf("\033PrSM0\033\\\033PpS(E)\033\\"); X if (textmode && shown) gigiturt(); X break; X case '*': X printf("\033[K"); X } X} X END_OF_gigi.i if test 2132 -ne `wc -c <gigi.i`; then echo shar: \"gigi.i\" unpacked with wrong size! fi # end of overwriting check fi if test -f helpfile -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"helpfile\" else echo shar: Extracting \"helpfile\" $398 characters$ sed "s/^X//" >helpfile <<'END_OF_helpfile' X XLogo is an interactive procedural programming language designed for Xeducation. The file X /usr/src/cmd/logo/logoman Xis an nroff-format logo manual. To find out about a particular Logo Xprimitive, use the "describe" command with the name of the primitive as Xits input, e.g. X describe "print Xto see the description of the print command. X XThe command to leave Logo is "goodbye" (abbreviated "bye"). X END_OF_helpfile if test 398 -ne `wc -c <helpfile`; then echo shar: \"helpfile\" unpacked with wrong size! fi # end of overwriting check fi if test ! -d library ; then echo shar: Creating directory \"library\" mkdir library fi if test -f library/beep.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/beep.lg\" else echo shar: Extracting \"library/beep.lg\" $27 characters$ sed "s/^X//" >library/beep.lg <<'END_OF_library/beep.lg' X Xto beep :n Xhitoot :n Xend X END_OF_library/beep.lg if test 27 -ne `wc -c <library/beep.lg`; then echo shar: \"library/beep.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/f.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/f.lg\" else echo shar: Extracting \"library/f.lg\" $38 characters$ sed "s/^X//" >library/f.lg <<'END_OF_library/f.lg' X Xto f :thing Xoutput first :thing Xend X END_OF_library/f.lg if test 38 -ne `wc -c <library/f.lg`; then echo shar: \"library/f.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/g.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/g.lg\" else echo shar: Extracting \"library/g.lg\" $70 characters$ sed "s/^X//" >library/g.lg <<'END_OF_library/g.lg' X Xto g Xpr [The abbreviation for 'goodbye' is now 'bye', not 'g'.] Xend X END_OF_library/g.lg if test 70 -ne `wc -c <library/g.lg`; then echo shar: \"library/g.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/gigimove.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/gigimove.lg\" else echo shar: Extracting \"library/gigimove.lg\" $151 characters$ sed "s/^X//" >library/gigimove.lg <<'END_OF_library/gigimove.lg' X XREPLACE THE TWO-CHAR SEQUENCE ^[ WITH AN ESCAPE, TWICE IN THIS FILE Xto gigimove :x :y Xtype "^[PpP\[ Xtype :x+384 Xtype ", Xtype 240-:y Xtype "\]^[\\ Xend X END_OF_library/gigimove.lg if test 151 -ne `wc -c <library/gigimove.lg`; then echo shar: \"library/gigimove.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/hanoi.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/hanoi.lg\" else echo shar: Extracting \"library/hanoi.lg\" $190 characters$ sed "s/^X//" >library/hanoi.lg <<'END_OF_library/hanoi.lg' X Xto hanoi :number :from :to :other Xif equalp :number 0 [stop] Xhanoi :number-1 :from :other :to Xprint {sentence [Move disk] :number "from :from "to :to} Xhanoi :number-1 :other :to :from Xend X END_OF_library/hanoi.lg if test 190 -ne `wc -c <library/hanoi.lg`; then echo shar: \"library/hanoi.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/home.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/home.lg\" else echo shar: Extracting \"library/home.lg\" $31 characters$ sed "s/^X//" >library/home.lg <<'END_OF_library/home.lg' X Xto home Xsetxy 0 0 Xseth 0 Xend X END_OF_library/home.lg if test 31 -ne `wc -c <library/home.lg`; then echo shar: \"library/home.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/howis.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/howis.lg\" else echo shar: Extracting \"library/howis.lg\" $135 characters$ sed "s/^X//" >library/howis.lg <<'END_OF_library/howis.lg' X Xto howis :whatever Xif equalp first :whatever "w output "wonderful Xif equalp first :whatever "t output "terrific Xoutput "ordinary Xend X END_OF_library/howis.lg if test 135 -ne `wc -c <library/howis.lg`; then echo shar: \"library/howis.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/l.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/l.lg\" else echo shar: Extracting \"library/l.lg\" $37 characters$ sed "s/^X//" >library/l.lg <<'END_OF_library/l.lg' X Xto l :thing Xoutput last :thing Xend X END_OF_library/l.lg if test 37 -ne `wc -c <library/l.lg`; then echo shar: \"library/l.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/laugh.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/laugh.lg\" else echo shar: Extracting \"library/laugh.lg\" $47 characters$ sed "s/^X//" >library/laugh.lg <<'END_OF_library/laugh.lg' X Xto laugh Xpr "ha Xpr [ha ha] Xpr [ha ha ha] Xend X END_OF_library/laugh.lg if test 47 -ne `wc -c <library/laugh.lg`; then echo shar: \"library/laugh.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/listp.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/listp.lg\" else echo shar: Extracting \"library/listp.lg\" $58 characters$ sed "s/^X//" >library/listp.lg <<'END_OF_library/listp.lg' X Xto listp :listpobject Xoutput not wordp :listpobject Xend X END_OF_library/listp.lg if test 58 -ne `wc -c <library/listp.lg`; then echo shar: \"library/listp.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/pick.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/pick.lg\" else echo shar: Extracting \"library/pick.lg\" $55 characters$ sed "s/^X//" >library/pick.lg <<'END_OF_library/pick.lg' X Xto pick :list Xoutput nth 1+rnd count :list :list Xend X END_OF_library/pick.lg if test 55 -ne `wc -c <library/pick.lg`; then echo shar: \"library/pick.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/poly.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/poly.lg\" else echo shar: Extracting \"library/poly.lg\" $87 characters$ sed "s/^X//" >library/poly.lg <<'END_OF_library/poly.lg' X Xto poly :side :ang :num Xif :num=0 [stop] Xfd :side Xrt :ang Xpoly :side :ang :num-1 Xend X END_OF_library/poly.lg if test 87 -ne `wc -c <library/poly.lg`; then echo shar: \"library/poly.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/pos.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/pos.lg\" else echo shar: Extracting \"library/pos.lg\" $35 characters$ sed "s/^X//" >library/pos.lg <<'END_OF_library/pos.lg' X Xto pos Xoutput list xcor ycor Xend X END_OF_library/pos.lg if test 35 -ne `wc -c <library/pos.lg`; then echo shar: \"library/pos.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/quest.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/quest.lg\" else echo shar: Extracting \"library/quest.lg\" $146 characters$ sed "s/^X//" >library/quest.lg <<'END_OF_library/quest.lg' X Xto quest :question :answer Xtype :question Xif equalp request :answer [print [You're right!] ; stop] Xprint sentence [No, silly, it's] :answer Xend X END_OF_library/quest.lg if test 146 -ne `wc -c <library/quest.lg`; then echo shar: \"library/quest.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/quiz1.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/quiz1.lg\" else echo shar: Extracting \"library/quiz1.lg\" $163 characters$ sed "s/^X//" >library/quiz1.lg <<'END_OF_library/quiz1.lg' X Xto quiz1 Xtype [Who is the greatest musician of all time] Xif equalp request [John Lennon] [print [You're right!] ; stop] Xprint [No, silly, it's John Lennon!] Xend X END_OF_library/quiz1.lg if test 163 -ne `wc -c <library/quiz1.lg`; then echo shar: \"library/quiz1.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/setcursor.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/setcursor.lg\" else echo shar: Extracting \"library/setcursor.lg\" $63 characters$ sed "s/^X//" >library/setcursor.lg <<'END_OF_library/setcursor.lg' X Xto setcursor :place Xsetcursorxy first :place last :place Xend X END_OF_library/setcursor.lg if test 63 -ne `wc -c <library/setcursor.lg`; then echo shar: \"library/setcursor.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/setheight.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/setheight.lg\" else echo shar: Extracting \"library/setheight.lg\" $56 characters$ sed "s/^X//" >library/setheight.lg <<'END_OF_library/setheight.lg' X Xto setheight :height Xmake "gigitextheight :height Xend X END_OF_library/setheight.lg if test 56 -ne `wc -c <library/setheight.lg`; then echo shar: \"library/setheight.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/setitalic.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/setitalic.lg\" else echo shar: Extracting \"library/setitalic.lg\" $54 characters$ sed "s/^X//" >library/setitalic.lg <<'END_OF_library/setitalic.lg' X Xto setitalic :slant Xmake "gigitextitalic :slant Xend X END_OF_library/setitalic.lg if test 54 -ne `wc -c <library/setitalic.lg`; then echo shar: \"library/setitalic.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/setpos.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/setpos.lg\" else echo shar: Extracting \"library/setpos.lg\" $72 characters$ sed "s/^X//" >library/setpos.lg <<'END_OF_library/setpos.lg' X Xto setpos :setposplace Xsetxy first :setposplace last :setposplace Xend X END_OF_library/setpos.lg if test 72 -ne `wc -c <library/setpos.lg`; then echo shar: \"library/setpos.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/setsize.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/setsize.lg\" else echo shar: Extracting \"library/setsize.lg\" $48 characters$ sed "s/^X//" >library/setsize.lg <<'END_OF_library/setsize.lg' X Xto setsize :size Xmake "gigitextsize :size Xend X END_OF_library/setsize.lg if test 48 -ne `wc -c <library/setsize.lg`; then echo shar: \"library/setsize.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/setslant.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/setslant.lg\" else echo shar: Extracting \"library/setslant.lg\" $55 characters$ sed "s/^X//" >library/setslant.lg <<'END_OF_library/setslant.lg' X Xto setslant :slant Xmake "gigitextslant 45*:slant Xend X END_OF_library/setslant.lg if test 55 -ne `wc -c <library/setslant.lg`; then echo shar: \"library/setslant.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/setslope.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/setslope.lg\" else echo shar: Extracting \"library/setslope.lg\" $55 characters$ sed "s/^X//" >library/setslope.lg <<'END_OF_library/setslope.lg' X Xto setslope :slope Xmake "gigitextslope 45*:slope Xend X END_OF_library/setslope.lg if test 55 -ne `wc -c <library/setslope.lg`; then echo shar: \"library/setslope.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/setx.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/setx.lg\" else echo shar: Extracting \"library/setx.lg\" $47 characters$ sed "s/^X//" >library/setx.lg <<'END_OF_library/setx.lg' X Xto setx :setxcoord Xsetxy :setxcoord ycor Xend X END_OF_library/setx.lg if test 47 -ne `wc -c <library/setx.lg`; then echo shar: \"library/setx.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/sety.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/sety.lg\" else echo shar: Extracting \"library/sety.lg\" $47 characters$ sed "s/^X//" >library/sety.lg <<'END_OF_library/sety.lg' X Xto sety :setycoord Xsetxy xcor :setycoord Xend X END_OF_library/sety.lg if test 47 -ne `wc -c <library/sety.lg`; then echo shar: \"library/sety.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/textprint.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/textprint.lg\" else echo shar: Extracting \"library/textprint.lg\" $442 characters$ sed "s/^X//" >library/textprint.lg <<'END_OF_library/textprint.lg' X XREPLACE THE TWO-CHAR SEQUENCE ^[ WITH AN ESCAPE, TWICE IN THIS FILE Xto textprint :text Xgigimove xcor ycor Xtype "^[PpT$B Xif namep "gigitextslope [type "D; type :gigitextslope] Xif namep "gigitextsize [type "S; type :gigitextsize] Xif namep "gigitextslant [type "D; type :gigitextslant] Xif namep "gigitextheight [type "H; type :gigitextheight] Xif namep "gigitextitalic [type "I; type :gigitextitalic] Xtype "$' Xtype :text Xtype "'$E$^[\\ Xend X END_OF_library/textprint.lg if test 442 -ne `wc -c <library/textprint.lg`; then echo shar: \"library/textprint.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/top.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/top.lg\" else echo shar: Extracting \"library/top.lg\" $22 characters$ sed "s/^X//" >library/top.lg <<'END_OF_library/top.lg' X Xto top Xtoplevel Xend X END_OF_library/top.lg if test 22 -ne `wc -c <library/top.lg`; then echo shar: \"library/top.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f library/towards.lg -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"library/towards.lg\" else echo shar: Extracting \"library/towards.lg\" $60 characters$ sed "s/^X//" >library/towards.lg <<'END_OF_library/towards.lg' X Xto towards :pos Xoutput towardsxy first :pos last :pos Xend X END_OF_library/towards.lg if test 60 -ne `wc -c <library/towards.lg`; then echo shar: \"library/towards.lg\" unpacked with wrong size! fi # end of overwriting check fi if test -f logohead.c -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"logohead.c\" else echo shar: Extracting \"logohead.c\" $310 characters$ sed "s/^X//" >logohead.c <<'END_OF_logohead.c' X X/* Print the first line of selected files. Used by Logo pots command. */ X X#include <stdio.h> X Xmain(argc,argv) Xint argc; Xchar **argv; X{ X FILE *fp; X char line[100]; X X while (--argc > 0) { X if ((fp = fopen(argv[1],"r")) != NULL) { X fgets(line,100,fp); X printf("%s",line); X fclose(fp); X } X argv++; X } X} X END_OF_logohead.c if test 310 -ne `wc -c <logohead.c`; then echo shar: \"logohead.c\" unpacked with wrong size! fi # end of overwriting check fi if test -f main.c -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"main.c\" else echo shar: Extracting \"main.c\" $1080 characters$ sed "s/^X//" >main.c <<'END_OF_main.c' X X/* This provides the outermost framework of LOGO, calling the parser to X * begin with, and then thereafter whenever an interrupt or error occurs. X * Copyright (C) 1979, The Children's Museum, Boston, Mass. X * Written by Douglas B. Klunder. X */ X X#include "logo.h" X Xchar editfile[30]; Xextern char *getbpt; X#ifndef NOTURTLE Xextern int turtdes; Xextern struct display *mydpy; X#endif X#ifdef SETCURSOR X#include <sgtty.h> Xstruct sgttyb tty; X#endif X Xmain(argc,argv) Xint argc; Xchar *argv[]; X{ X int i[2]; X char tbuff[BUFSIZ]; X X setbuf(stdout,tbuff); X time(i); X SRAND(i[1]+i[0]); X sprintf(editfile,"/tmp/logo%u",(short)getpid()); X#ifdef SETCURSOR X gtty(1,&tty); X#endif X if (argc>1) X getbpt = argv[1]; X else X printf("\nWelcome to Children's Museum/LSRHS LOGO\n?"); X fflush(stdout); X while (enter()==1) { X yyprompt(1); X } X cboff(); X#ifdef SETCURSOR X stty(1,&tty); X#endif X#ifndef NOTURTLE X#ifdef FLOOR X if (turtdes>0) X printf("Please\007 unplug the turtle\007 and put it\007 away.\n"); X#endif X if (turtdes<0) { X printf(mydpy->finish); X (*mydpy->outfn)(); X } X#endif X unlink(editfile); X} X END_OF_main.c if test 1080 -ne `wc -c <main.c`; then echo shar: \"main.c\" unpacked with wrong size! fi # end of overwriting check fi if test -f makefile -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"makefile\" else echo shar: Extracting \"makefile\" $717 characters$ sed "s/^X//" >makefile <<'END_OF_makefile' X Xall: logo logohead X Xlogo: y.tab.o logoparse.o zerr.o main.o logoop.o logoaux.o unix.o \ Xstorage.o turtle.o procedit.o logonum.o procvars.o logoproc.o proplist.o X ld -X -i -o logo /lib/crt0.o *.o -lm -lc -ltermlib X Xy.tab.c: logo.y X yacc logo.y X Xturtle.c: atari.i gigi.i adm.i tek.i admtek.i sun.i X touch turtle.c X Xlogohead: logohead.c X cc -O -o logohead logohead.c X Xhelp: splithelp logoman X ./makehelp X Xsplithelp: splithelp.c X cc -O -o splithelp splithelp.c X X.c.o: ;cc -O -c $*.c X Xinstall: X cp logo /bin/logo X mkdir /usr/doc/logo X cp help/* /usr/doc/logo X cp helpfile applediff olddiff /usr/doc/logo X mkdir /usr/lib/logo X cp library/* /usr/lib/logo X cp logohead /usr/lib/logo X Xclean: X rm *.o logo logohead splithelp X END_OF_makefile if test 717 -ne `wc -c <makefile`; then echo shar: \"makefile\" unpacked with wrong size! fi # end of overwriting check fi if test -f makehelp -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"makehelp\" else echo shar: Extracting \"makehelp\" $35 characters$ sed "s/^X//" >makehelp <<'END_OF_makehelp' Xed - logoman << 'foo' X1i X.pl 999i X END_OF_makehelp if test 35 -ne `wc -c <makehelp`; then echo shar: \"makehelp\" unpacked with wrong size! fi # end of overwriting check fi if test -f proplist.c -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"proplist.c\" else echo shar: Extracting \"proplist.c\" $3698 characters$ sed "s/^X//" >proplist.c <<'END_OF_proplist.c' X X/* Property list primitives */ X X#include "logo.h" X X#ifndef SMALL X Xstruct property { X char *prname; X struct object *prvalue; X struct property *prnext; X}; X Xstruct proplist { X char *plname; X struct property *props; X struct proplist *plnext; X} *allprops = NULL; X Xstruct proplist *findplist(var) Xchar *var; X{ X register struct proplist *plp; X X for (plp=allprops; plp; plp=plp->plnext) X if (!strcmp(var,plp->plname)) return(plp); X return(0); X} X Xstruct property *findprop(prp,name) Xregister struct property *prp; Xchar *name; X{ X for (; prp; prp=prp->prnext) X if (!strcmp(name,prp->prname)) return(prp); X return(0); X} X Xpprop(name,prop,object) Xstruct object *name,*prop,*object; X{ X char *nstr; X register struct proplist *plp; X register struct property *prp,*prp1; X X if (!stringp(name)) ungood("Pprop",name); X if (!stringp(prop)) ungood("Pprop",prop); X if ((plp=findplist(token(name->obstr)))==0) { X plp=(struct proplist *)ckmalloc(sizeof(struct proplist)); X nstr = ckmalloc(1+strlen(name->obstr)); X strcpy(nstr,token(name->obstr)); X plp->plname = nstr; X plp->props = 0; X plp->plnext = allprops; X allprops = plp; X } X prp = plp->props; X if (prp1 = findprop(prp,prop->obstr)) { X lfree(prp1->prvalue); X } else { X prp1 = (struct property *)ckmalloc(sizeof(struct property)); X nstr = ckmalloc(1+strlen(prop->obstr)); X strcpy(nstr,token(prop->obstr)); X prp1->prname = nstr; X prp1->prnext = prp; X plp->props = prp1; X } X prp1->prvalue = globcopy(object); X mfree(name); X mfree(prop); X mfree(object); X} X Xremprop(name,prop) Xstruct object *name,*prop; X{ X register struct proplist *plp; X register struct property *prp,*prp1; X X if (!stringp(name)) ungood("Remprop",name); X if (!stringp(prop)) ungood("Remprop",prop); X if ((plp=findplist(token(name->obstr)))==0) { X pf1("%p has no properties\n",name); X errhand(); X } X prp = plp->props; X for (prp1=0; prp; prp=prp->prnext) { X if (!strcmp(prp->prname,token(prop->obstr))) { X if (prp1) X prp1->prnext = prp->prnext; X else X plp->props = prp->prnext; X JFREE(prp->prname); X lfree(prp->prvalue); X JFREE(prp); X break; X } X prp1 = prp; X } X if (prp == 0) { X pf1("%p has no %p property.\n",name,prop); X errhand(); X } X mfree(name); X mfree(prop); X} X Xstruct object *gprop(name,prop) Xstruct object *name,*prop; X{ X register struct proplist *plp; X register struct property *prp,*prp1; X X if (!stringp(name)) ungood("Gprop",name); X if (!stringp(prop)) ungood("Gprop",prop); X if ((plp=findplist(token(name->obstr)))==0) { X mfree(name); X mfree(prop); X return(0); X } X prp = plp->props; X if (prp1 = findprop(prp,token(prop->obstr))) { X mfree(name); X mfree(prop); X return(localize(prp1->prvalue)); X } else { X mfree(name); X mfree(prop); X return(0); X } X} X Xpps() { X register struct proplist *plp; X register struct property *prp; X register char *name; X X for (plp=allprops; plp; plp=plp->plnext) { X name = plp->plname; X for (prp=plp->props; prp; prp=prp->prnext) { X pf1("%s's %s is %p\n",name,prp->prname,prp->prvalue); X } X } X} X Xstruct object *plist(name) Xstruct object *name; X{ X register struct proplist *plp; X register struct property *prp; X register struct object *tail; X struct object *head; X X if (!stringp(name)) ungood("Plist",name); X if ((plp=findplist(token(name->obstr)))==0) { X mfree(name); X return(0); X } X if ((prp = plp->props)==0) { X mfree(name); X return(0); X } X head = tail = globcons(0,0); X for (; prp; prp=prp->prnext) { X tail->obcar = globcopy(objcpstr(prp->prname)); X tail->obcdr = globcopy(globcons(0,0)); X tail = tail->obcdr; X tail->obcar = globcopy(prp->prvalue); X if (prp->prnext) tail->obcdr = globcopy(globcons(0,0)); X else tail->obcdr = 0; X tail = tail->obcdr; X } X mfree(name); X return(localize(head)); X} X X#endif X END_OF_proplist.c if test 3698 -ne `wc -c <proplist.c`; then echo shar: \"proplist.c\" unpacked with wrong size! fi # end of overwriting check fi if test -f splithelp.c -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"splithelp.c\" else echo shar: Extracting \"splithelp.c\" $1772 characters$ sed "s/^X//" >splithelp.c <<'END_OF_splithelp.c' X X/* X * splithelp.c -- turn nroff output of logoman into help files. X * X * For this to work, there must be no em dashes in the logoman source X * except on lines which name primitives. Also, the file which is X * nroffed isn't the actual logoman, but a version which has been edited X * by the makehelp shell script (which also runs this program) to change X * what's where. The algorithm is that a primitive description starts X * with a line with a dash (represented here as a tilde) and continues X * until a line with a nonspace, nonempty first character. X */ X X#include <stdio.h> X Xint memb(ch,str) Xregister char ch; Xregister char *str; X{ X register char ch1; X X while (ch1 = *str++) X if (ch == ch1) X return(1); X return(0); X} X Xmain(argc,argv) Xchar **argv; X{ X FILE *ip, *op; X int writing = 0; /* nonzero when writing a file */ X int empty = 0; /* nonzero after an empty line */ X register char *cp; X char line[100]; X char primitive[30]; X X if ((ip = fopen(argv[1],"r")) == NULL) { X printf("Splithelp: Can't read input.\n"); X exit(1); X } X X while (fgets(line,100,ip)) { X if (memb('~',line)) { /* start new file */ X empty = 0; X if (writing) X fclose(op); X sscanf(line,"%s",primitive); X if (strlen(primitive) > 9) { X for (cp = line; *cp && *cp!=':'; cp++) ; X sscanf(cp+2,"%s",primitive); X } X if ((op = fopen(primitive,"w")) == NULL) { X printf("Splithelp: Can't write output.\n"); X exit(1); X } X for (cp = line; *cp != '~'; cp++) ; X *cp++ = '-'; X *cp = '-'; X fprintf(op,"%s",line); X writing++; X } else if (line[0] == '\n') { X empty++; X } else if (writing && line[0]==' ') { X if (empty) fprintf(op,"\n"); X empty = 0; X fprintf(op,"%s",line); X } else if (writing) { X fclose(op); X writing = 0; X } X } X if (writing) fclose(op); X} X END_OF_splithelp.c if test 1772 -ne `wc -c <splithelp.c`; then echo shar: \"splithelp.c\" unpacked with wrong size! fi # end of overwriting check fi if test -f sun.i -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"sun.i\" else echo shar: Extracting \"sun.i\" $1858 characters$ sed "s/^X//" >sun.i <<'END_OF_sun.i' X X/* Include file for turtle.c for Sun Microsystems workstation */ X X#include <gfx.h> X/* If we are on a Sun, Logo must be loaded -lgfx */ X Xint sunturt(),sunfrom(),sunto(),suninit(),sunstate(); Xstruct display sun ={0.0,0.0,0.0,-1000.0,1000.0,-1000.0,1000.0,1.0,0, X "","","","",sunturt,sunfrom,sunto,nullfn,suninit,nullfn, X nullfn,nullfn,nullfn,sunstate}; X XNUMBER sunoldx,sunoldy; X Xtransline(type,fromx,fromy,tox,toy) { X line(type,fromx+screen.w/2,screen.h/2-fromy,tox+screen.w/2, X screen.h/2-toy); X} X Xsunturt(hide) Xint hide; /* nonzero to erase turtle */ X{ X double newx,newy,oldx,oldy,angle; X X angle = (mydpy->turth-90.0)*3.141592654/180.0; X oldx = mydpy->turtx + 15.0*sin(angle); X oldy = mydpy->turty + 15.0*cos(angle); X angle = mydpy->turth*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X transline(GXinvert,(int)oldx,(int)(yscrunch*oldy), X (int)newx,(int)(yscrunch*newy)); X oldx = newx; X oldy = newy; X angle = (mydpy->turth+90.0)*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X transline(GXinvert,(int)oldx,(int)(yscrunch*oldy), X (int)newx,(int)(yscrunch*newy)); X oldx = newx; X oldy = newy; X angle = (mydpy->turth-90.0)*3.141592654/180.0; X newx = mydpy->turtx + 15.0*sin(angle); X newy = mydpy->turty + 15.0*cos(angle); X transline(GXinvert,(int)oldx,(int)(yscrunch*oldy), X (int)newx,(int)(yscrunch*newy)); X} X Xsuninit() { X initscreen(); X drasterop(GXset,0,0,SCREEN,1024,1024); X} X Xsunfrom(x,y) XNUMBER x,y; X{ X sunoldx = x; X sunoldy = y; X} X Xsunto(x,y) XNUMBER x,y; X{ X static int sunpens[] = {GXclear,GXset,GXinvert}; X /* NOTE should be set,clear but it works this way, why??? */ X X transline((sunpens[penerase], X (int)sunoldx,(int)sunoldy,(int)x,(int)y); X} X Xsunstate(which) { X if (which == 'c' || which == 'w') X drasterop(GXset,0,0,SCREEN,1024,1024); X} X END_OF_sun.i if test 1858 -ne `wc -c <sun.i`; then echo shar: \"sun.i\" unpacked with wrong size! fi # end of overwriting check fi if test -f tek.i -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"tek.i\" else echo shar: Extracting \"tek.i\" $835 characters$ sed "s/^X//" >tek.i <<'END_OF_tek.i' X X/* Include file for turtle.c for TEK */ X Xint tekfrom(),tekto(),tekin(),tekout(),tekstate(); Xstruct display tek ={0.0,0.0,0.0,-512.0,511.0,-390.0,389.0,1.0,0, X "","\032\035\033\014\030","","\032\035\033\014\030", X nullfn,tekfrom,tekto,nullfn,tekin,tekout,nullfn, X nullfn,nullfn,tekstate}; X Xtekfrom(x,y) Xdouble x,y; X{ X printf("\035"); X plotpos((int)x,(int)y); X} X Xtekto(x,y) Xdouble x,y; X{ X plotpos((int)x,(int)y); X printf("\035\067\177\040\100\037\030"); X} X Xtekin() { X shown = 0; X system("stty -lcase"); X} X Xtekout() { X system("stty lcase"); X} X Xtekstate(which) { X switch(which) { X case 'R': X printf("Tek can't penreverse, setting pendown\n."); X penerase = 0; X return; X case 'E': X printf("Tek can't penerase, setting pendown.\n"); X penerase = 0; X return; X case 'S': X printf("Tek can't showturtle.\n"); X shown = 0; X } X} X END_OF_tek.i if test 835 -ne `wc -c <tek.i`; then echo shar: \"tek.i\" unpacked with wrong size! fi # end of overwriting check fi if test -f unix.c -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"unix.c\" else echo shar: Extracting \"unix.c\" $3955 characters$ sed "s/^X//" >unix.c <<'END_OF_unix.c' X X#include "logo.h" X#include <setjmp.h> X#include <signal.h> X Xchar *ostring; XFILE *ofile; X#ifdef DEBUG Xint memtrace=0; Xextern int yydebug; X#endif X X#ifdef PAUSE X Xint errpause=0; X Xseterrpause() { X errpause++; X} X Xclrerrpause() { X errpause = 0; X} X#endif X Xstruct object *stringform(arg) Xregister struct object *arg; X{ X char str[IBUFSIZ]; X struct object *bigsave(); X#ifdef DEBUG X int omemt; X X omemt = memtrace; X memtrace = 0; X#endif X ostring = &str[0]; X str[0] = '\0'; /* in case of empty */ X tyobj(arg); X ostring = 0; X#ifdef DEBUG X memtrace = omemt; X#endif X return (bigsave(str)); X} X Xputch(ch) Xregister ch; X{ X if (ch != -1) { X putchar(ch); X } X return (ch); X} X X/* VARARGS */ Xchar *cpystr(to,f1,f2,f3,f4,f5,f6,f7,f8,f9,f0) Xregister char *to; Xchar *f1,*f2,*f3,*f4,*f5,*f6,*f7,*f8,*f9,*f0; X{ X char *out,**in; X X out = to; X in = &f1; X while (*in) { X strcpy(out,*in); X out += strlen(*in); X in++; X } X return (out); X} X Xjmp_buf env; X Xextern errrec(); X Xint floflo() { X signal(SIGFPE,floflo); X puts("Arithmetic overflow."); X errhand(); X} X Xenter() X{ X register x; X X if (x=setjmp(env)) { X return(x); X } else { X onintr(errrec,1); X signal(SIGFPE,floflo); X return (yyparse()); X } X} X Xleave(val) X{ X putchar('\n'); X longjmp(env,val); X} X Xint sigarg; Xint (*intfun)(); Xextern sigquit(); X#ifdef PAUSE Xint pausesig = PAUSESIG; Xint othersig = OTHERSIG; Xint psigflag = 0; X Xsigpaws() { /* User signals a pause request */ X signal(pausesig,sigpaws); X psigflag++; X} X#endif X Xonintr(inttf,val) Xregister int (*inttf)(),val; X{ X sigarg = val; X#ifdef PAUSE X signal(othersig,sigquit); X signal(pausesig,sigpaws); X#else X signal(SIGINT,sigquit); X signal(SIGQUIT,sigquit); X#endif X intfun = inttf; X} X X#ifdef DEBUG Xint deb_quit=0; X#endif X Xsigquit() X{ X#ifdef DEBUG X if(deb_quit) abort(); X#endif X alarm(0); X#ifdef PAUSE X signal(othersig,sigquit); X#else X signal(SIGINT,sigquit); X signal(SIGQUIT,sigquit); X#endif X (*intfun)(sigarg); X} X X#ifdef DEBUG Xsetdebquit() { X deb_quit++; X} X Xsetmemtrace() { X memtrace++; X} X Xsetyaccdebug() { X yydebug++; X} X#endif X X#ifdef PAUSE Xsetipause() { X pausesig = SIGINT; X othersig = SIGQUIT; X} X Xsetqpause() { X pausesig = SIGQUIT; X othersig = SIGINT; X} X#endif X Xputc1(cha) Xregister cha; X{ X if(ostring) X { X *ostring++=cha; X *ostring=0; X } X else if(ofile)fputc(cha,ofile); X else putchar(cha); X} Xsputs(str) Xregister char *str; X{ X register char c; X X if(ofile) X while (c = *str++) fputc(c&0177,ofile); X else if(ostring){ X while (c = *str++) { X if (c & 0200) *ostring++ = '\\'; X *ostring++ = c & 0177 ; X } X *ostring = '\0'; X } X else X while (c = *str++) fputc(c&0177,stdout); X} Xnputs(str) Xregister char *str; X{ X register char c; X X while (c = *str++) fputc(c,stdout); X} X X/*VARARGS*/ Xpf1(str,a1,a2,a3,a4) Xregister char *str; Xstruct object *a1,*a2,*a3,*a4; X{ X register c; X register struct object **arg; X#ifdef DEBUG X int omemt; X X omemt = memtrace; X memtrace = 0; X#endif X arg= &a1; X while(c= *str++){ X if(c=='%'){ X c= *str++; X if(c=='d'){ X if(ostring){ X sprintf(ostring,"%d",(int)(*arg++)); X ostring+=strlen(ostring); X }else if(ofile) X fprintf(ofile,"%d",(int)(*arg++)); X else printf("%d",(int)(*arg++)); X } else if(c=='o'){ X if(ostring){ X sprintf(ostring,"%o",(int)(*arg++)); X ostring+=strlen(ostring); X }else if(ofile) X fprintf(ofile,"%o",(int)(*arg++)); X else printf("%o",(int)(*arg++)); X } else if(c=='s'){ X if(ostring){ X strcpy(ostring,(char *)(*arg++)); X ostring += strlen(ostring); X } else if (ofile) X fprintf(ofile,"%s",(char *)(*arg++)); X else printf("%s",(char *)(*arg++)); X } else if(c=='l'){ X if(!listp(*arg)){ X if(emptyp(*arg)) sputs("empty"); X else if(stringp(*arg) && !nump(*arg)) X putc1('\"'); X } X fty1(*arg++); X } else if(c=='p') { X if(!stringp(*arg)) { X *arg=stringform(*arg); X sputs((*arg)->obstr); X mfree(*arg); X } else sputs((*arg)->obstr); X arg++; X } X else putc1(c); X } X else putc1(c); X } X#ifdef DEBUG X memtrace = omemt; X#endif X} X END_OF_unix.c if test 3955 -ne `wc -c <unix.c`; then echo shar: \"unix.c\" unpacked with wrong size! fi # end of overwriting check fi if test -f zerr.c -a "${1}" != "-c" ; then echo shar: Will not over-write existing file \"zerr.c\" else echo shar: Extracting \"zerr.c\" $2650 characters$ sed "s/^X//" >zerr.c <<'END_OF_zerr.c' X X/* This file contains most of the error messages for LOGO, along with X* the functions that print the various messages. X* X* Copyright (C) 1979, The Children's Museum, Boston, Mass. X* Written by Douglas B. Klunder. X*/ X#include "logo.h" Xextern int yychar,errtold; Xextern short yyerrflag; Xextern char *ibufptr; Xextern char charib; Xextern int letflag; Xextern struct lexstruct keywords[]; X Xaerr2(etype,arg,op) /* This handles an unknown second input to infix X * arithmetic operations. */ Xregister char *etype,*arg; Xchar op; X{ X if (!errtold) { X nputs(etype); X pf1(" of %l and what?\n",arg); X putchar(op); X puts(" must have two numbers for inputs."); X errtold++; X } X} X Xnotenf(op) Xregister op; X{ X if (!errtold) { X pf1("Not enough inputs to %s.\n",keywords[op].word); X errtold++; X } X} X X Xunerr(c) /* Unknown following unary - or +. */ Xregister char c; X{ X if (!errtold) { X putchar(c); X puts(" what?"); X putchar(c); X pf1(" must be followed by a number.\n"); X errtold++; X } X} Xinferr(arg,op) /* Incorrect second input to infix operator. */ Xregister char *arg; Xregister op; X{ X if (!errtold) { X switch(op) { X case '+': aerr2("sum",arg,'+');break; X case '-': aerr2("difference",arg,'-');break; X case '*': aerr2("product",arg,'*');break; X case '/': aerr2("quotient",arg,'/');break; X case '\\': aerr2("remainder",arg,'\\');break; X case '<': aerr2("lessp",arg,'<');break; X case '>': aerr2("greaterp",arg,'>');break; X case '^': aerr2("pow",arg,'^');break; X case '=': X pf1("equalp of %l and what?\n",arg); X puts("= takes two inputs."); X } X errtold++; X } X} Xop2er1(op,arg) /* No second input to two-input operation. */ Xregister op; Xregister char *arg; X{ X if (!errtold) { X nputs(keywords[op].word); X pf1(" of %l and what?\n",arg); X nputs(keywords[op].word); X puts(" takes two inputs."); X errtold++; X } X} Xterr() /* Incorrect title. */ X{ X puts("That doesn't look like a title to me."); X errclear(); X} Xyyerror(str) Xregister char *str; X{ X if ( *str == 'y') { X puts("Too many levels of recursion."); X errtold++; X } X/* yacc has two messages. We ignore "syntax error" which has been dealt with Xdownlevel already, and on "yacc stack overflow" we must clear out the tables. X */ X} X Xlogoyerror() /* General unknown command. */ X{ X if (yychar==1) return; X puts("I don't understand that."); X puts("Please submit a Logo bug report, telling what you typed,"); X puts(" and asking for a more specific error message."); X} Xerrclear() /* clear error status in editor. */ X{ X ibufptr=NULL; X yychar= -1; X yyerrflag=0; X letflag=0; X} Xungood(name,val) Xregister char *name,*val; X{ X nputs(name); X pf1(" doesn't like %l as input.\n",val); X errhand(); X} X END_OF_zerr.c if test 2650 -ne `wc -c <zerr.c`; then echo shar: \"zerr.c\" unpacked with wrong size! fi # end of overwriting check fi echo shar: End of archive 1 $of 6$. cp /dev/null ark1isdone MISSING="" for I in 1 2 3 4 5 6 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 6 archives. echo "Now see the README" rm -f ark[1-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0